Option default integer
MODE 2
'-----------------------------------------------------------------------------
'show infoscreen (test)
'-----------------------------------------------------------------------------
FRAMEBUFFER layer create
FRAMEBUFFER write n
Load image "disp\BG2.bmp",0,20 'quaterscreen
Blit 0,20,160,20,160,100
Blit 0,20,0,120,320,100
FRAMEBUFFER write l
Load image "disp\Banner.bmp",0,20
FRAMEBUFFER write n

write 0 ,104,"LEVEL 1         JUST DIG!",RGB(RED)
write 0,136,"           NUMBER OF LEMMINGS  10",RGB(cyan)
write 0,152,"           10% TO BE SAVED",RGB(GREEN)
write 0,168,"           RELEASE RATE 50",RGB(RUST)
write 0,184,"           TIME    5 MINUTES",RGB(0,170,255)
write 0,200,"           RATING  FUN",RGB(255,85,255)
Pause 2000

'instead of 3, insert the Number of a free flash Slot here:
Flash load image 3,"Sprites/Lemming.bmp",o
CLS
FRAMEBUFFER write l
CLS
FRAMEBUFFER write n

snum=10

Dim sprt(80,8),ssrc(15,8)
Const SPTyp=1
Const SPX=2
Const SPY=3
Const SPDIR=4
Const SPAni=5
Const SPAniMax=6
Const SPSkill=7
Const SPCounter=8  'counter used by Builder,Exploder and Fall
'-----------------------------------------------------------------------------
'Lemming types and attributes
'Sourscoordinates 0=xr,1=yr,2=xl,3=yl,4=Number of Animationframes
'(where to find the sourcesprite)
' Climber
' Floater
' Exploder
' Blocker
' Builder
' Basher
' Miner
' Digger
'----- Not assignable -----
' Walker
' Faller
' Shrugger
' Flipper
' Splatter
' Homer
'-----------------------------------------------------------------------------
Const LemWalker=1
ssrc(1,0)=0:ssrc(1,1)=0: ssrc(1,2)=128:ssrc(1,3)=0: ssrc(1,4)=8
Const ALemClimber=2
ssrc(2,0)=0:ssrc(2,1)=16: ssrc(2,2)=0:ssrc(2,3)=32: ssrc(2,4)=8
Const LemFloater=3
ssrc(3,0)=0:ssrc(3,1)=48: ssrc(3,2)=128:ssrc(3,3)=48: ssrc(3,4)=8
Const LemExploder=4
ssrc(4,0)=0:ssrc(4,1)=64: ssrc(4,4)=32
Const LemBlocker=5
ssrc(5,0)=0:ssrc(5,1)=96: ssrc(5,4)=16
Const LemHomer=6
ssrc(6,0)=0:ssrc(6,1)=320: ssrc(6,4)=8
Const LemSinker=7
ssrc(7,0)=0:ssrc(7,1)=112: ssrc(7,4)=30
Const LemBuilder=8
ssrc(8,0)=0:ssrc(8,1)=144: ssrc(8,2)=0:ssrc(8,3)=160: ssrc(8,4)=16
Const LemBasher=9
ssrc(9,0)=0:ssrc(9,1)=208: ssrc(9,2)=0:ssrc(9,3)=240: ssrc(9,4)=32
Const LemDigger=10
ssrc(10,0)=0:ssrc(10,1)=192:ssrc(10,2)=0:ssrc(10,3)=192:ssrc(10,4)=8
Const LemMiner=11
ssrc(11,0)=0:ssrc(11,1)=272: ssrc(11,2)=96:ssrc(11,3)=288: ssrc(11,4)=22
Const LemFaller=12
ssrc(12,0)=224:ssrc(12,1)=128:ssrc(12,4)=2
Const LemClimberEnd=13
ssrc(13,0)=128:ssrc(13,1)=16: ssrc(13,2)=128:ssrc(13,3)=32: ssrc(13,4)=8
Const LemSplatter=14
ssrc(14,0)=0:ssrc(14,1)=80: ssrc(14,4)=16
Dim mActive

FsrcX=240:FscrY=304'Frame used as marker in HUD
mx=152:my=80
MsrcX=208:MsrcY=304
'-----------------------------------------------------------------------------
'                     SoundFX Samplenumbers in MOD
'-----------------------------------------------------------------------------
sAssignSkill=&H0A
sBearTrap=&H0B
sBuilderWarning=&H0C
sDrowning=&H0D
sElectroTrap=&H0E
sEntranceOpening=&H0F
sExplosion=&H10
sHitsSteel=&H11
sLetsGo=&H12
sOhNo=&H13
sRopeTrap=&H14
sSkillButtonSelect=&H15
sSplat=&H16
sTenTonTrap=&H17
sVaporizing=&H18
sYippee=&H19

'-----------------------------------------------------------------------------
'testrun
'-----------------------------------------------------------------------------
Play modfile "music/cancan.mod"
Play modsample sLetsGo,1
Load image "disp/HUD3.BMP",0,180
'Load image "disp/Screenshot.BMP",0,20
Load image "disp/Dig.BMP",-122,20
'HUD labelling
write 112,180,"OUT 10   IN   %  TIME  -  ",RGB(cyan)
Box 3,197,10,8,,0,0
Box 19,197,10,8,,0,0
Box 147,197,10,8,,0,0
Text 4,198,"50",,8,,RGB(White),-1
Text 20,198,"50",,8,,RGB(White),-1
Text 148,198,"10",,8,,RGB(White),-1

'Entrance Opening
dorx=74:dory=54
openEntrance dorx,dory
FRAMEBUFFER write l

lmax=10:LP=2500:LT=Timer:lms=0
'-----------------------------------------------------------------------------
'main loop
'-----------------------------------------------------------------------------
Do
  'Spawn new Lemming?
  If lms<lmax Then
    If Timer >=LT Then Spawn_Lemming:Inc lms:LT=Timer+LP
  End If
  mActive=0
  'Move
  move_lms
  'Display Lemmings and Mouse
  disp_lms
  Do :Loop Until Timer>=tt
  mx=DEVICE(MOUSE 2,x):my=DEVICE(MOUSE 2,y):Mclk=DEVICE(MOUSE 2,l)
  tt=Timer+50
  If mclk Then
     Play Modsample sSkillButtonSelect,3
     sprt(Alem,SPTyp)=LemDigger
  End If
Loop

'-----------------------------------------------------------------------------
'display all aktive lemmings
'-----------------------------------------------------------------------------
Sub disp_lms
  Local f,srcx,srcy,lTyp,lAni,lDir
  FRAMEBUFFER write l
  FRAMEBUFFER wait
  CLS
  For f=1 To snum
  lTyp=sprt(f,SPTyp)
  If lTyp Then
     ldir=sprt(f,SPDIR)<<1
     srcx=ssrc(lTyp,ldir)
     srcy=ssrc(lTyp,ldir+1)
     lAni=sprt(f,SPAni)<<4
    If lAni>255 Then Inc srcy,16:Inc lAni,-256
    Blit Flash 3,l, srcx+lAni,srcy,sprt(f,SPX),sprt(f,SPY),16,16,9
   End If
  Next
   Blit flash 3,l,MsrcX+mActive,MsrcY,mx,my,16,16,9'Mouse Cursor
End Sub

'-----------------------------------------------------------------------------
'move_lms *** Move all Lemmings ***
'Here the lemmings behaviour originates
'Essentially the lemmings brain
'Here is the calculations for the sprite positions take place.
'however, nothing is drawn.
'-----------------------------------------------------------------------------
Sub move_lms
  Local f',styp
  FRAMEBUFFER write n
  mouse_grid_x = Mx >> 4
  mouse_grid_y = My >> 4
  Alem=0
  For f=1 To snum
    styp=sprt(f,SPTyp)
    'Lemmings behavioural treatment
    Select Case sprt(f,SPTyp)
      Case LemWalker
        'SPDIR,SPX ,SPY
        'Todo: add exeptions if SPSkill=Climber
        '      test if it transforms to faller
        If sprt(f,SPDIR) Then
          Inc sprt(f,SPX),-1
          If Pixel(sprt(f,SPX)+6,sprt(f,SPY)+10) Then sprt(f,SPDIR)=0
        Else
          Inc sprt(f,SPX)
          If Pixel(sprt(f,SPX)+12,sprt(f,SPY)+10)Then sprt(f,SPDIR)=1
        End If
        'touch ground?
          If Pixel(sprt(f,SPX)+8,sprt(f,SPY)+15) Then
            Inc sprt(f,SPY),-1
          Else
            Inc sprt(f,SPY)
          End If
      Case LemClimber
      Case LemClimberEnd
      Case LemFloater
        Inc sprt(f,SPY)
        'turn into walker if landed
        If Pixel(sprt(f,SPX)+8,sprt(f,SPY)+15) Then
          sprt(f,SPCounter)=0
          sprt(f,SPTyp)=LemWalker
        End If
      Case LemExploder
        'turns SPTyp into 0 after animation ends
      Case LemBlocker
      Case LemEscaper
      Case LemSinker
      Case LemBuilder
      Case LemBasher

     Case LemDigger
        If sprt(f,SPAni)=0 Or sprt(f,SPAni)=8 Then
         Box sprt(f,SPX),sprt(f,SPY)+15,16,1,,0,0
         Inc sprt(f,SPY)
         If Not Pixel(sprt(f,SPX),sprt(f,SPY)+15)Then
           If Not Pixel(sprt(f,SPX)+1,sprt(f,SPY)+15) Then sprt(f,SPTyp)=LemFaller
         End If
         EndIf
      Case LemMiner
      Case LemFaller
        'can turn into walker or splatter depending on the fallheight (SPCounter)
        Inc sprt(f,SPCounter)
        Inc sprt(f,SPY),2
        If Pixel(sprt(f,SPX)+8,sprt(f,SPY)+15) Then
          sprt(f,SPCounter)=0
          sprt(f,SPTyp)=LemWalker
        End If
      Case LemSplatter
        'turns SPTyp into 0 after animation ends
      Case LemHomer
      'turns SPTyp into 0 after animation ends
    End Select
    'change to next animation step
    If styp Then
      Inc sprt(f,SPAni)
      If  sprt(f,SPAni)>=ssrc(styp,4) Then sprt(f,SPAni)=0
    End If
    'in Cursor range?
    sr_x = sprt(f,SPX) >> 4
    sr_y = sprt(f,SPY) >> 4
    If mouse_grid_x = sr_x And mouse_grid_y = sr_y  Then  mActive=16:Alem=f
   End If
  Next
  FRAMEBUFFER write l
End Sub

'-----------------------------------------------------------------------------
'a new lemming is born
'-----------------------------------------------------------------------------
Sub Spawn_Lemming
  'search next free Slot in Sprite-Array
  Local nr=1
  Do
    If sprt(nr,SPTyp)=0 Then Exit Do
    Inc nr
    If nr>80 Then Exit Sub
  Loop
  'create new Lemming (Fall) under the Entrance
  sprt(nr,SPTyp)=LemFaller
  sprt(nr,SPX)=Dorx+12
  sprt(nr,SPY)=Dory+4
  sprt(nr,SPDIR)=0
  sprt(nr,SPAni)=0
  sprt(nr,SPSkill)=0
  sprt(nr,SPCounter)=0
End Sub

'-----------------------------------------------------------------------------
Sub Write tx,ty,txt$,tcol
'Not the final version yet
  Text tx,ty,txt$,,9,,RGB(0,85,0),-1
  Text tx,ty+1,txt$,,9,,tcol,-1
End Sub
'-----------------------------------------------------------------------------
Sub openEntrance DoorX,DoorY
 Local f
 Play modsample sEntranceOpening,4
 For f=0 To 9
  Box DoorX,DoorY,40,24,,0,0
  Blit Flash 3,n,256,f*22,DoorX,DoorY,40,22,9
  Pause 75
 Next
End Sub


' Font_Lemmings (For the time being, til I find a better one)
' Font type    : 59 Characters (UpperCase)
' Font size    : 8x16 pixel
' Memory usage : 944 Bytes
DefineFont #9
3B201008
00000000000000000000000000000000 30303030303030303030003000303030
FC6C6C24000000480000000000000000 FE6C6C006C6CFCFEEEFEFE6C00006C6C
7E3C10103870E0E67CFECE1C00101038 C6C6C2C218180C0C666630300086C6C6
D8D8F87070F8D8D8DEDEDAF80076FEDC 30181810000000300000000000000000
3818180C3030303038303030000C1818 38303060181818183818181800603030
7C541000FE7C38387C38387C00001054 101000007C7C10101010107C00000010
00000000000000003010000020607030 000000007C7C00000000007C00000000
00000000000000007020000000207070 0C0606023018180CC0606030000080C0
FE7C7C38C6C6C6C6FEC6C6C600387C7C 38787838181818181818181800181818
7EFEFC78783C1C0EFEE0E07000FEFEFE FEFEFE7C1C0E06C6FEC6060E007CFEFE
1C1C0C0C6C6C3C3CFEFEFECC000C0C0C C0FCFEFC3E7CF8C0FEC60606007CFEFE
C0FC7C3CFEFCF8C0C6C6C6C6007CFEFE FEFEFEFE181C0C0C3038181800303030
C6FE7C7CFE7CC6C6C6C6C6FE007CFEFE C6FEFE7CC6C6C6C60E7EFEFE00783C1C
10000000103838383838100000001038 10000000103838383010000020607030
181C0C08607030381838307000080C1C 7C00000000007C7C7C7C7C0000000000
307060200C1C18383038181C00206070 7EFE7E3C181C0E060000181810383810
9EC47C38A6A6A6BE9EBEA6A6003C6240 FE7C7C38FEC6C6C6C6FEFEFE00C6C6C6
C6FEFCFCFCFCFEC6FEC6C6C600FCFEFE FE7E7E3CC0C0C0E6FEE6C0C0003C7E7E
FEFCFCF8C2C2C6C6FEC6C6C200F8FCFC FCFEFEFCF8F8F0C0FCC0C0F000FCFEFE
FCFEFEFCF8F8C0C0C0C0C0F800C0C0C0 F2FE7E3ECECEC0E0FEE2C6CE003E7E7E
C6C6C6C6FEFEC6C6C6C6C6FE00C6C6C6 387C7C7C3838383838383838007C7C7C
0E0E0E048E0E0E0EEEEECECE00387C7C DCCCCCC4F0F0F8F8CCCCD8F800C6C6C6
E0E0E0C0E0E0E0E0FCE0E0E000FEFEFE FEEEC6C6D6FEFEFEC6C6C6C600C6C6C6
FEFCFCF8C6C6C6CEC6C6C6C600C6C6C6 EE7C7C38C6C6C6C6EEC6C6C600387C7C
CEFCFCF8CEC6C6C6C0F8FCFC00C0C0C0 EE7C7C38C2C6C6C6EECEC2C2023A7E7E
CEFCFCF8C6C6C6C6CCFCFCCE02C2C6C6 E6FEFE7C7CF8E0C0CE060E1E007CFEFE
FEFEFEFE383838383838383800383838 C6C6C684C6C6C6C67CEEC6C600387C7C
C6C682826CEEC6C638286C6C00101038 C6C6C682D6C6C6C6EEFEFEFE00C6C6EE
EEC6C68238387C6CEE6C7C380082C6C6 C6C6C682387C6CEE3838383800383838
0EFEFEFE38181C0CFE60703000FEFEFE
End DefineFont
